home *** CD-ROM | disk | FTP | other *** search
/ HTBasic 9.3 / HTBasic 9.3.iso / LgcyPlus / disk2 / BMAPVIEW._ / BMAPVIEW.
Encoding:
Text File  |  2001-03-02  |  6.8 KB  |  201 lines
  1. 10    ! ******************************************************************
  2. 20    !
  3. 30    ! Example: Bitmap Viewer
  4. 40    !
  5. 50    ! This program demonstrates the use of the BITMAP widget. It
  6. 60    ! allows you to bring in and display bitmaps, as well as select
  7. 70    ! portions of them and save them in a file.
  8. 80    !
  9. 90    ! It also demonstrates the SCROLLABLE attribute for the PANEL ...
  10. 100   ! in particular the various operations needed to make SCROLL WIDTH
  11. 110   ! and SCROLL HEIGHT as correct as possible..
  12. 120   !
  13. 130   ! ******************************************************************
  14. 140   !
  15. 150   ! A few variables:
  16. 160   !
  17. 170   !   S$:        General-purpose string.
  18. 180   !   N:         General-purpose variable.
  19. 190   !   Btn:       Returns button value from dialogs.
  20. 200   !   Sc:        Scroll factor.
  21. 210   !   Bitfile$:  Name of bitmap file to be read.
  22. 220   !   Dirname$:  Directory name returned from FILE dialog.
  23. 230   !   B1$(*):    Stores MENU BUTTONS.
  24. 240   !   A1$,A2$:   Stores dialog attributes.
  25. 250   !
  26. 260   DIM S$[256]
  27. 270   INTEGER N,Btn,Sc
  28. 280   DIM Bitfile$[100],Dirname$[100],Btns$(1:3)[50],A1$[50],A2$[50]
  29. 290   !
  30. 300   DATA "BMP File","XWD File","Cancel","DIALOG BUTTONS","SELECTION",20
  31. 310   READ Btns$(*),A1$,A2$,Sc
  32. 320   !
  33. 330   ! Widget dimensions.
  34. 340   !
  35. 350   INTEGER Pw,Ph,Px,Py,Iw,Ih,Ww,Wh,Wx,Wy
  36. 360   !
  37. 370   ! Variables for display scaling.
  38. 380   !
  39. 390   INTEGER Cursor,D(1:4),Dw,Dh
  40. 400   !
  41. 410   ! Get display size.
  42. 420   !
  43. 430   GESCAPE CRT,3;D(*)
  44. 440   Dw=D(3)-D(1)
  45. 450   Dh=D(4)-D(2)
  46. 460   !
  47. 470   CLEAR SCREEN
  48. 480   KEY LABELS OFF
  49. 490   RUNLIGHT OFF
  50. 500   STATUS CRT,10;Cursor
  51. 510   CONTROL CRT,10;0
  52. 520   !
  53. 530   Pw=Dw*.7            ! PANEL width.
  54. 540   Ph=Dh*.7            ! PANEL height.
  55. 550   Px=(Dw-Pw)/2        ! Center PANEL.
  56. 560   Py=(Dh-Ph)/2
  57. 570   !
  58. 580   ! Create PANEL for BITMAP widget. Note how the SCROLL WIDTH
  59. 590   ! and HEIGHT are set to a small value so that scroll bars will not
  60. 600   ! appear initially. The actual heights are set later to fit the bitmap
  61. 610   ! that has been loaded.
  62. 620   !
  63. 630   ASSIGN @Main TO WIDGET "PANEL";SET ("VISIBLE":0)
  64. 640   CONTROL @Main;SET ("X":Px,"Y":Py,"WIDTH":Pw,"HEIGHT":Ph)
  65. 650   CONTROL @Main;SET ("TITLE":"Example: Bitmap Viewer")
  66. 660   CONTROL @Main;SET ("SIZE CONTROL":"SCROLLABLE","MINIMIZABLE":1)
  67. 670   CONTROL @Main;SET ("SCROLL WIDTH":1,"SCROLL WIDTH UNITS":Sc)
  68. 680   CONTROL @Main;SET ("SCROLL HEIGHT":1,"SCROLL HEIGHT UNITS":Sc)
  69. 690   !
  70. 700   ! Build menu.
  71. 710   !
  72. 720   ASSIGN @Menu TO WIDGET "PULLDOWN MENU";PARENT @Main
  73. 730   CONTROL @Menu;SET ("LABEL":"Menu")
  74. 740   ASSIGN @Getfile TO WIDGET "MENU BUTTON";PARENT @Menu
  75. 750   CONTROL @Getfile;SET ("LABEL":"Get Bitmap File")
  76. 760   ASSIGN @Savefile TO WIDGET "MENU BUTTON";PARENT @Menu
  77. 770   CONTROL @Savefile;SET ("LABEL":"Cut Bitmap To File")
  78. 780   ASSIGN @Cd TO WIDGET "MENU BUTTON";PARENT @Menu
  79. 790   CONTROL @Cd;SET ("LABEL":"Change Directory")
  80. 800   ASSIGN @S TO WIDGET "MENU SEPARATOR";PARENT @Menu
  81. 810   ASSIGN @Quit TO WIDGET "MENU BUTTON";PARENT @Menu
  82. 820   CONTROL @Quit;SET ("LABEL":"Quit")
  83. 830   !
  84. 840   ! Create and size BITMAP widget. (Setting RETAIN RASTER makes the
  85. 850   ! widget redraw quickly when overwritten by a dialog.)
  86. 860   !
  87. 870   ASSIGN @Bitmap TO WIDGET "BITMAP";PARENT @Main
  88. 880   CONTROL @Bitmap;SET ("RETAIN RASTER":1,"AUTO SIZE":1)
  89. 890   STATUS @Main;RETURN ("INSIDE WIDTH":Iw,"INSIDE HEIGHT":Ih)
  90. 900   Wx=Iw*.01
  91. 910   Wy=Ih*.01
  92. 920   Wh=Ih*.98
  93. 930   Ww=Iw*.98
  94. 940   CONTROL @Bitmap;SET ("X":Wx,"Y":Wy,"WIDTH":Ww,"HEIGHT":Wh)
  95. 950   !
  96. 960   ! Set events.
  97. 970   !
  98. 980   ON EVENT @Getfile,"ACTIVATED" GOSUB Getbitfile
  99. 990   ON EVENT @Savefile,"ACTIVATED" GOSUB Savebits
  100. 1000  ON EVENT @Cd,"ACTIVATED" GOSUB Chdir
  101. 1010  ON EVENT @Quit,"ACTIVATED" GOTO Finis
  102. 1020  !
  103. 1030  CONTROL @Main;SET ("VISIBLE":1)
  104. 1040  !
  105. 1050  ! Loop and wait for input.
  106. 1060  !
  107. 1070  LOOP
  108. 1080  END LOOP
  109. 1090  STOP
  110. 1100  !
  111. 1110  ! *********************** End of Main Program **********************
  112. 1120  !
  113. 1130  ! This routine gets a bitmap file and displays it.  Note how it gets
  114. 1140  ! the bitmap size and sets up PANEL scrolling accordingly. Note also
  115. 1150  ! how it turns the BITMAP widget invisible so the display will
  116. 1160  ! "thrash" as little as possible.
  117. 1170  !
  118. 1180 Getbitfile: !
  119. 1190  S$="Please enter the name of a bitmap (.XWD or .BMP) file:"
  120. 1200  DIALOG "FILE",S$,Btn;RETURN ("SELECTION":Bitfile$)
  121. 1210  !
  122. 1220  IF Btn=0 THEN
  123. 1230    CLEAR ERROR
  124. 1240    ON ERROR GOSUB Errtrap
  125. 1250    CONTROL @Bitmap;SET ("VISIBLE":0,"BITMAP FILE":Bitfile$)
  126. 1260    OFF ERROR
  127. 1270    IF ERRN<>0 THEN
  128. 1280      DIALOG "ERROR","Can't open file / invalid bitmap file."
  129. 1290      CONTROL @Bitmap;SET ("BITMAP FILE":"","VISIBLE":1)
  130. 1300    ELSE
  131. 1310      CONTROL @Bitmap;SET ("VISIBLE":0)
  132. 1320      STATUS @Bitmap;RETURN ("BITMAP HEIGHT":Wh,"BITMAP WIDTH":Ww)
  133. 1330      CONTROL @Main;SET ("SCROLL HEIGHT":2+INT(Wh/Sc))
  134. 1340      CONTROL @Main;SET ("SCROLL WIDTH":2+INT(Ww/Sc))
  135. 1350      CONTROL @Bitmap;SET ("VISIBLE":1)
  136. 1360      DIALOG "INFORMATION","File read completed!"
  137. 1370    END IF
  138. 1380  END IF
  139. 1390  RETURN
  140. 1400  !
  141. 1410  ! This routine allows you to cut a section of a bitmap and
  142. 1420  ! save it in a file.  Note how string variables are used in
  143. 1430  ! the FILE dialog to specify the DIALOG BUTTONS attribute and
  144. 1440  ! the SELECTION attribute in order to keep the length of the
  145. 1450  ! statement compact.
  146. 1460  !
  147. 1470 Savebits: !
  148. 1480  S$="Enter file name, then click-and-drag image to save:"
  149. 1490  DIALOG "FILE",S$,Btn;SET (A1$:Btns$(*)),RETURN (A2$:Bitfile$)
  150. 1500  !
  151. 1510  SELECT Btn
  152. 1520  CASE 0
  153. 1530    S$="BMP"   ! Dump format is MS-Windows .BMP file.
  154. 1540  CASE 1
  155. 1550    S$="XWD"   ! Dump format is X11 XWD format.
  156. 1560  CASE 2
  157. 1570    RETURN
  158. 1580  END SELECT
  159. 1590  !
  160. 1600  CLEAR ERROR
  161. 1610  ON ERROR GOSUB Errtrap
  162. 1620  CONTROL @Bitmap;SET ("DUMP FORMAT":S$,"DUMP AREA":Bitfile$)
  163. 1630  OFF ERROR
  164. 1640  IF ERRN<>0 THEN
  165. 1650    DIALOG "ERROR","Can't open file."
  166. 1660  ELSE
  167. 1670    DIALOG "INFORMATION","Bitmap saved to "&S$&" file."
  168. 1680  END IF
  169. 1690  !
  170. 1700  RETURN
  171. 1710  !
  172. 1720  ! This routine changes directories.
  173. 1730  !
  174. 1740 Chdir: !
  175. 1750  S$="Please enter the name of a directory:"
  176. 1760  DIALOG "FILE",S$,Btn;RETURN ("DIRECTORY":Dirname$)
  177. 1770  !
  178. 1780  Err=0
  179. 1790  CLEAR ERROR
  180. 1800  ON ERROR GOSUB Errtrap
  181. 1810  MASS STORAGE IS Dirname$
  182. 1820  OFF ERROR
  183. 1830  IF ERRN<>0 THEN
  184. 1840    DIALOG "ERROR","Can't change directory!"
  185. 1850  END IF
  186. 1860  RETURN
  187. 1870  !
  188. 1880  ! Dummy routine for trapping errors.
  189. 1890  !
  190. 1900 Errtrap: ERROR RETURN
  191. 1910  !
  192. 1920  ! ************** Go Here When Done ***********************
  193. 1930  !
  194. 1940 Finis: !
  195. 1950  ASSIGN @Main TO *
  196. 1960  CLEAR SCREEN
  197. 1970  KEY LABELS ON
  198. 1980  RUNLIGHT ON
  199. 1990  CONTROL CRT,10;Cursor
  200. 2000  END
  201.